home *** CD-ROM | disk | FTP | other *** search
/ Dr. Windows 3 / dr win3.zip / dr win3 / UTILITY1 / MSWLGO35.ZIP / EXAMPLES / STUDENT < prev    next >
Text File  |  1993-04-12  |  35KB  |  1,170 lines
  1. ;
  2. ; Function:
  3. ;
  4. ; Mathamatical word problem sovler.
  5. ;
  6. ; Load "student
  7. ; Call STUDENT [problem]
  8. ;
  9. ; Example: (many others at bottom)
  10. ;
  11. ; STUDENT :jet
  12. ;
  13. TO ABS :NUM
  14. OP IFELSE (:NUM < 0) [-:NUM] [:NUM]
  15. END
  16.  
  17. TO AGEIFY :SENT
  18. IF EMPTYP :SENT [OUTPUT []]
  19. IF NOT PERSONP FIRST :SENT [OUTPUT FPUT FIRST :SENT AGEIFY BF :SENT]
  20. CATCH "ERROR [IF EQUALP FIRST BF :SENT "S ~
  21.                  [OUTPUT FPUT FIRST :SENT AGEIFY BF :SENT]]
  22. OUTPUT (SE FIRST :SENT [S AGE] AGEIFY BF :SENT)
  23. END
  24.  
  25. TO AGEPROB
  26. LOCAL [BEG END SYM WHO NUM SUBJ AGES]
  27. WHILE [MATCH [^BEG AS OLD AS #END] :PROB] [MAKE "PROB SE :BEG :END]
  28. WHILE [MATCH [^BEG YEARS OLD #END] :PROB] [MAKE "PROB SE :BEG :END]
  29. WHILE [MATCH [^BEG WILL BE WHEN #END] :PROB] ~
  30.       [MAKE "SYM GENSYM ~
  31.        MAKE "PROB (SE :BEG "IN :SYM [YEARS . IN] :SYM "YEARS :END)]
  32. WHILE [MATCH [^BEG WAS WHEN #END] :PROB] ~
  33.       [MAKE "SYM GENSYM ~
  34.        MAKE "PROB (SE :BEG :SYM [YEARS AGO .] :SYM [YEARS AGO] :END)]
  35. WHILE [MATCH [^BEG !WHO:PERSONP WILL BE IN !NUM YEARS #END] :PROB] ~
  36.       [MAKE "PROB (SE :BEG :WHO [S AGE IN] :NUM "YEARS #END)]
  37. WHILE [MATCH [^BEG WAS #END] :PROB] [MAKE "PROB (SE :BEG "IS :END)]
  38. WHILE [MATCH [^BEG WILL BE #END] :PROB] [MAKE "PROB (SE :BEG "IS :END)]
  39. WHILE [MATCH [^BEG !WHO:PERSONP IS NOW #END] :PROB] ~
  40.       [MAKE "PROB (SE :BEG :WHO [S AGE NOW] :END)]
  41. WHILE [MATCH [^BEG !NUM YEARS FROM NOW #END] :PROB] ~
  42.       [MAKE "PROB (SE :BEG "IN :NUM "YEARS :END)]
  43. MAKE "PROB AGEIFY :PROB
  44. IFELSE MATCH [^ !WHO:PERSONP ^END S AGE #] :PROB ~
  45.        [MAKE "SUBJ SE :WHO :END] [MAKE "SUBJ "SOMEONE]
  46. MAKE "PROB AGEPRON :PROB
  47. MAKE "END :PROB
  48. MAKE "AGES []
  49. WHILE [MATCH [^ !WHO:PERSONP ^BEG AGE #END] :END] ~
  50.       [PUSH "AGES (SE "AND :WHO :BEG "AGE)]
  51. MAKE "AGES BF REDUCE "SE REMDUP :AGES
  52. WHILE [MATCH [^BEG THEIR AGES #END] :PROB] [MAKE "PROB (SE :BEG :AGES :END)]
  53. MAKE "SIMSEN MAP [AGESEN ?] BRACKET :PROB
  54. END
  55.  
  56. TO AGEPRON :SENT
  57. IF EMPTYP :SENT [OUTPUT []]
  58. IF NOT PRONOUN FIRST :SENT [OUTPUT FPUT FIRST :SENT AGEPRON BF :SENT]
  59. IF POSSPRO FIRST :SENT [OUTPUT (SE :SUBJ "S AGEPRON BF :SENT)]
  60. OUTPUT (SE :SUBJ [S AGE] AGEPRON BF :SENT)
  61. END
  62.  
  63. TO AGESEN :SENT
  64. LOCAL [WHEN REST NUM]
  65. MAKE "WHEN []
  66. IF MATCH [IN !NUM YEARS #REST] :SENT ~
  67.    [MAKE "WHEN SE "PLUSS :NUM MAKE "SENT :REST]
  68. IF MATCH [!NUM YEARS AGO #REST] :SENT ~
  69.    [MAKE "WHEN SE "MINUSS :NUM MAKE "SENT :REST]
  70. OUTPUT AGEWHEN :SENT
  71. END
  72.  
  73. TO AGEWHEN :SENT
  74. IF EMPTYP :SENT [OUTPUT []]
  75. IF NOT EQUALP FIRST :SENT "AGE [OUTPUT FPUT FIRST :SENT AGEWHEN BF :SENT]
  76. IF MATCH [IN !NUM YEARS #REST] BF :SENT ~
  77.    [OUTPUT (SE [AGE PLUSS] :NUM AGEWHEN :REST)]
  78. IF MATCH [!NUM YEARS AGO #REST] BF :SENT ~
  79.    [OUTPUT (SE [AGE MINUSS] :NUM AGEWHEN :REST)]
  80. IF EQUALP "NOW FIRST BF :SENT [OUTPUT SE "AGE AGEWHEN BF BF :SENT]
  81. OUTPUT (SE "AGE :WHEN AGEWHEN BF :SENT)
  82. END
  83.  
  84. TO ARTICLE :WORD
  85. OP MEMBERP :WORD [A AN THE]
  86. END
  87.  
  88. TO BKT1 :PROBLIST
  89. LOCAL [FIRST WORD REST]
  90. IF EMPTYP :PROBLIST [OUTPUT []]
  91. IF NOT MEMBERP ", FIRST :PROBLIST [OP FPUT FIRST :PROBLIST BKT1 BF :PROBLIST]
  92. IF MATCH [IF ^FIRST , !WORD:QWORD #REST] FIRST :PROBLIST ~
  93.    [OP BKT1 FPUT (SE :FIRST ".) FPUT (SE :WORD :REST) BF :PROBLIST]
  94. IF MATCH [^FIRST , AND #REST] FIRST :PROBLIST ~
  95.    [OP FPUT (SE :FIRST ".) (BKT1 FPUT :REST BF :PROBLIST)]
  96. OP FPUT FIRST :PROBLIST BKT1 BF :PROBLIST
  97. END
  98.  
  99. TO BRACKET :PROB
  100. OUTPUT BKT1 FINDDELIM :PROB
  101. END
  102.  
  103. TO CHANGEONE :CHANGE
  104. LOCAL "END
  105. IF NOT MATCH (SE FIRST :CHANGE [#END]) :SENT [OP "FALSE]
  106. MAKE "SENT RUN (SE "SE LAST :CHANGE ":END)
  107. OP "TRUE
  108. END
  109.  
  110. TO CHANGES :SENT :LIST
  111. LOCAL "KEYWORDS
  112. MAKE "KEYWORDS MAP.SE [FINDKEY FIRST ?] :LIST
  113. OP CHANGES1 :SENT :LIST :KEYWORDS
  114. END
  115.  
  116. TO CHANGES1 :SENT :LIST :KEYWORDS
  117. IF EMPTYP :SENT [OP []]
  118. IF MEMBERP FIRST :SENT :KEYWORDS [OP CHANGES2 :SENT :LIST :KEYWORDS]
  119. OP FPUT FIRST :SENT CHANGES1 BF :SENT :LIST :KEYWORDS
  120. END
  121.  
  122. TO CHANGES2 :SENT :LIST :KEYWORDS
  123. CHANGES3 :LIST :LIST
  124. OP FPUT FIRST :SENT CHANGES1 BF :SENT :LIST :KEYWORDS
  125. END
  126.  
  127. TO CHANGES3 :BIGLIST :NOWLIST
  128. IF EMPTYP :NOWLIST [STOP]
  129. IF CHANGEONE FIRST :NOWLIST [CHANGES3 :BIGLIST :BIGLIST STOP]
  130. CHANGES3 :BIGLIST BF :NOWLIST
  131. END
  132.  
  133. TO DENOM :FRACT :ADDENDS
  134. MAKE "ADDENDS SIMPLUS :ADDENDS
  135. LOCAL "DEN
  136. MAKE "DEN LAST :FRACT
  137. IF NOT EQUALP FIRST :ADDENDS "QUOTIENT ~
  138.    [OP SIMDIV LIST ~
  139.                (SIMONE "SUM ~
  140.                        (REMOP "SUM LIST (DISTRIBTIMES (LIST :ADDENDS) :DEN) ~
  141.                                         FIRST BF :FRACT)) :DEN]
  142. IF EQUALP :DEN LAST :ADDENDS ~
  143.    [OP SIMDIV (SIMPLUS LIST (FIRST BF :FRACT) (FIRST BF :ADDENDS)) :DEN]
  144. LOCAL "LOWTERMS
  145. MAKE "LOWTERMS SIMDIV LIST :DEN LAST :ADDENDS
  146. OP SIMDIV LIST (SIMPLUS (SIMTIMES LIST FIRST BF :FRACT LAST :LOWTERMS) ~
  147.                         (SIMTIMES LIST FIRST BF :ADDENDS FIRST BF :LOWTERMS)) ~
  148.                (SIMTIMES LIST FIRST BF :LOWTERMS LAST :ADDENDS)
  149. END
  150.  
  151. TO DEPUNCT :WORD
  152. IF EMPTYP :WORD [OP []]
  153. IF EQUALP FIRST :WORD "$ [OP SE "$ DEPUNCT BF :WORD]
  154. IF EQUALP LAST :WORD "% [OP SE DEPUNCT BL :WORD "PERCENT]
  155. IF MEMBERP LAST :WORD [. ? |;| ,] [OP SE DEPUNCT BL :WORD LAST :WORD]
  156. IF EMPTYP BF :WORD [OP :WORD]
  157. IF EQUALP LAST2 :WORD "'S [OP SE DEPUNCT BL BL :WORD "S]
  158. OP :WORD
  159. END
  160.  
  161. TO DISTRIBTIMES :TRMS :MULTIPLIER
  162. OP SIMPLUS MAP [SIMTIMES (LIST ? :MULTIPLIER)] :TRMS
  163. END
  164.  
  165. TO DISTRIBX :EXPR
  166. LOCAL [OPER ARGS]
  167. IF EMPTYP :EXPR [OP :EXPR]
  168. MAKE "OPER FIRST :EXPR
  169. IF NOT OPERATORP :OPER [OP :EXPR]
  170. MAKE "ARGS MAP [DISTRIBX ?] BF :EXPR
  171. IF REDUCE "AND MAP [NUMBERP ?] :ARGS [OP RUN (SE [(] :OPER :ARGS [)])]
  172. IF EQUALP :OPER "SUM [OP SIMPLUS :ARGS]
  173. IF EQUALP :OPER "MINUS [OP MINUSIN FIRST :ARGS]
  174. IF EQUALP :OPER "PRODUCT [OP SIMTIMES :ARGS]
  175. IF EQUALP :OPER "QUOTIENT [OP SIMDIV :ARGS]
  176. OP FPUT :OPER :ARGS
  177. END
  178.  
  179. TO DIVTERM :DIVIDEND :DIVISOR
  180. IF EQUALP :DIVIDEND 0 [OP 0]
  181. OP SIMDIV LIST :DIVIDEND :DIVISOR
  182. END
  183.  
  184. TO DLM :WORD
  185. OP MEMBERP :WORD [. ? |;|]
  186. END
  187.  
  188. TO EXPT :NUM :POW
  189. IF :POW < 1 [OP 1]
  190. OP :NUM * EXPT :NUM :POW - 1
  191. END
  192.  
  193. TO FACTOR :EXPRS :VAR
  194. LOCAL "TRMS
  195. MAKE "TRMS MAP [FACTOR1 :VAR ?] :EXPRS
  196. IF MEMBERP "UNKNOWN :TRMS [OP FPUT "UNKNOWN :EXPRS]
  197. OP LIST :VAR SIMPLUS :TRMS
  198. END
  199.  
  200. TO FACTOR1 :VAR :EXPR
  201. LOCAL "NEGVAR
  202. MAKE "NEGVAR MINUSIN :VAR
  203. IF EQUALP :VAR :EXPR [OP 1]
  204. IF EQUALP :NEGVAR :EXPR [OP -1]
  205. IF EMPTYP :EXPR [OP "UNKNOWN]
  206. IF EQUALP FIRST :EXPR "PRODUCT [OP FACTOR2 BF :EXPR]
  207. IF NOT EQUALP FIRST :EXPR "QUOTIENT [OP "UNKNOWN]
  208. LOCAL "DIVIDEND
  209. MAKE "DIVIDEND FIRST BF :EXPR
  210. IF EQUALP :VAR :DIVIDEND [OP (LIST "QUOTIENT 1 LAST :EXPR)]
  211. IF NOT EQUALP FIRST :DIVIDEND "PRODUCT [OP "UNKNOWN]
  212. LOCAL "RESULT
  213. MAKE "RESULT FACTOR2 BF :DIVIDEND
  214. IF EQUALP :RESULT "UNKNOWN [OP "UNKNOWN]
  215. OP (LIST "QUOTIENT :RESULT LAST :EXPR)
  216. END
  217.  
  218. TO FACTOR2 :TRMS
  219. IF MEMBERP :VAR :TRMS [OP SIMONE "PRODUCT (REMOVE :VAR :TRMS)]
  220. IF MEMBERP :NEGVAR :TRMS [OP MINUSIN SIMONE "PRODUCT (REMOVE :NEGVAR :TRMS)]
  221. OP "UNKNOWN
  222. END
  223.  
  224. TO FINDDELIM :SENT
  225. OP FINDDELIM1 :SENT [] []
  226. END
  227.  
  228. TO FINDDELIM1 :IN :OUT :SIMPLES
  229. IF EMPTYP :IN ~
  230.    [IFELSE EMPTYP :OUT [OP :SIMPLES] [OP LPUT (SE :OUT ".) :SIMPLES]]
  231. IF DLM FIRST :IN ~
  232.    [OP FINDDELIM1 (BF :IN) [] (LPUT (SE :OUT FIRST :IN) :SIMPLES)]
  233. OP FINDDELIM1 (BF :IN) (SE :OUT FIRST :IN) :SIMPLES
  234. END
  235.  
  236. TO FINDKEY :PATTERN
  237. IF EQUALP FIRST :PATTERN "!:IN [OP FIRST BF :PATTERN]
  238. IF EQUALP FIRST :PATTERN "?:IN [OP SE (ITEM 2 :PATTERN) (ITEM 3 :PATTERN)]
  239. OP FIRST :PATTERN
  240. END
  241.  
  242. TO GETEQNS :VARS
  243. OP MAP.SE [GPROP VARKEY ? "EQNS] :VARS
  244. END
  245.  
  246. TO IDIOMS :SENT
  247. LOCAL "NUMBER
  248. OP CHANGES :SENT ~
  249.     [[[THE SUM OF] ["SUM]] [[SQUARE OF] ["SQUARE]] [[OF] ["NUMOF]] ~
  250.      [[HOW OLD] ["WHAT]] [[IS EQUAL TO] ["IS]] ~
  251.      [[YEARS YOUNGER THAN] [[LESS THAN]]] [[YEARS OLDER THAN] ["PLUS]] ~
  252.      [[PERCENT LESS THAN] ["PERLESS]] [[LESS THAN] ["LESSTHAN]] ~
  253.      [[THESE] ["THE]] [[MORE THAN] ["PLUS]] ~
  254.      [[FIRST TWO NUMBERS] [[THE FIRST NUMBER AND THE SECOND NUMBER]]] ~
  255.      [[THREE NUMBERS] ~
  256.       [[THE FIRST NUMBER AND THE SECOND NUMBER AND THE THIRD NUMBER]]] ~
  257.      [[ONE HALF] [0.5]] [[TWICE] [[2 TIMES]]] ~
  258.      [[$ !NUMBER] [SE :NUMBER "DOLLARS]] [[CONSECUTIVE TO] [[1 PLUS]]] ~
  259.      [[LARGER THAN] ["PLUS]] [[PER CENT] ["PERCENT]] [[HOW MANY] ["HOWM]] ~
  260.      [[IS MU